Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/SEND2UTL.PAS

Pascal/Delphi Source File | 1996-04-20 | 5KB | 203 lines

UNIT Send2Utl;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Routines for manipulating the SendTo struct   Last changed: 20.04.96  SA ║}
{║                                                                          ║}
{║                         (C) Copyright 1989-93 by                         ║}
{║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
{║                                                                          ║}
{║ This source may not be given to anybody, without the written permission  ║}
{║ from The Portal Team.                                                    ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}

INTERFACE

USES Use32, PoPTypes;

PROCEDURE ReadSendTo(CONST SendTo: SendToType; VAR Tab:SendToTabType; VAR Num:BYTE);
PROCEDURE WriteSendTo(VAR Tab:SendToTabType; VAR SendTo:SendToType; Num:BYTE);
PROCEDURE SortSendToTab(VAR Tab:SendToTabType; Num:BYTE);
FUNCTION  AddToSendTo(CONST Add: TFidoAddress; VAR Tab:SendToTabType; VAR Num:BYTE):BOOLEAN;
FUNCTION  RemoveFromSendTo(CONST Rem: TFidoAddress; VAR Tab:SendToTabType; VAR Num:BYTE):BOOLEAN;
FUNCTION  IsSendingTo(CONST Add: TFidoAddress; CONST Tab:SendToTabType; VAR Num:BYTE):BOOLEAN;

IMPLEMENTATION

USES OpString, StrUtil, MailUtil, Globals;

FUNCTION RemoveFromSendTo(CONST Rem: TFidoAddress; VAR Tab:SendToTabType; VAR Num:BYTE):BOOLEAN;
VAR
  Found,i:BYTE;
BEGIN
  RemoveFromSendTo:=FALSE;
  Found:=0;
  FOR i:=1 TO Num DO
    IF (Found=0) AND CmpAdr(Rem,Tab[i]) THEN Found:=i;
  IF Found<>0 THEN
  BEGIN
    RemoveFromSendTo:=TRUE;
    FOR i:=Found TO Num-1 DO
      Tab[i]:=Tab[i+1];
    DEC(Num);
  END;
END;

FUNCTION AddToSendTo(CONST Add: TFidoAddress; VAR Tab:SendToTabType; VAR Num:BYTE):BOOLEAN;
VAR
  Found:BOOLEAN;
BEGIN
  Found:=IsSendingTo(Add,Tab,Num);
  IF NOT Found THEN
  BEGIN
    INC(Num);
    Tab[Num]:=Add;
    Found:=TRUE;
  END;
  AddToSendTo:=Found;
END;

FUNCTION IsSendingTo(CONST Add: TFidoAddress; CONST Tab:SendToTabType; VAR Num:BYTE):BOOLEAN;
VAR
  i:BYTE;
  Found:Boolean;
BEGIN
  Found:=False;
  FOR i:=1 TO Num DO
    IF CmpAdr(Add,Tab[i]) THEN
    BEGIN
      Found:=TRUE;
      Break;
    END;
  IsSendingTo:=Found;
END;

PROCEDURE ReadSendTo(CONST SendTo: SendToType; VAR Tab: SendToTabType; VAR Num: BYTE);
VAR
  p,i,n:BYTE;
  sss,ss,s:S80;
  Test : INTEGER;
  Old  : TFidoAddress;
BEGIN
  FILLCHAR(Tab,SizeOf(Tab),0);
  Num:=0;
  FOR n:=1 TO 2 DO
  BEGIN
    s:=SendTo[n];
    IF s<>'' THEN
    BEGIN
      s:=s+' ';
      Replace(s,'  ',' ',0);
      WHILE (s<>'') AND (s[1]=' ') DO
        DELETE(s,1,1);
      Old.Zone:=Cfg.Addresses[Cfg.MainAdrNum].Zone; Old.Net:=0; Old.Node:=0; Old.Point:=0;
      FOR i:=1 TO WordCount(s,[' ']) DO
      BEGIN
        ss:=StUpCase(ExtractWord(i,s,[' ']));
        p:=POS(':',ss);
        IF p>0 THEN
        BEGIN
          sss:=COPY(ss,1,p-1);
          IF sss='ALL' THEN Old.Zone:=-1 ELSE VAL(sss,Old.Zone,Test);
          DELETE(ss,1,p);
        END;
        p:=POS('/',ss);
        IF p>0 THEN
        BEGIN
          sss:=COPY(ss,1,p-1);
          IF sss='ALL' THEN Old.Net:=-1 ELSE VAL(sss,Old.Net,Test);
          DELETE(ss,1,p);
        END;
        p:=POS('.',ss);
        IF p>0 THEN
        BEGIN
          sss:=COPY(ss,1,p-1);
          IF p>1 THEN
            IF sss='ALL' THEN Old.Node:=-1 ELSE VAL(COPY(ss,1,p-1),Old.Node,Test);
          DELETE(ss,1,p);
          IF ss='ALL' THEN Old.Point:=-1 ELSE VAL(ss,Old.Point,Test);
        END ELSE
        BEGIN
          IF ss='ALL' THEN Old.Node:=-1 ELSE VAL(ss,Old.Node,Test);
          Old.Point:=0;
        END;
        INC(Num);
        Tab[Num]:=Old;
      END;
    END;
  END;
END;

PROCEDURE WriteSendTo(VAR Tab:SendToTabType; VAR SendTo:SendToType; Num:BYTE);

LABEL
  Loop;
VAR
  n,i:BYTE;
  Add:STRING;
  Old: TFidoAddress;

  FUNCTION AllNum(Num:INTEGER):S50;
  VAR
    s:S50;
  BEGIN
    IF Num=-1 THEN s:='ALL' ELSE s:=Long2Str(Num);
    AllNum:=s;
  END;

BEGIN
  FillChar(Old, SizeOf(Old), 0);
  Old.Zone:=Cfg.Addresses[Cfg.MainAdrNum].Zone;
  FILLCHAR(SendTo,SizeOf(SendTo),0);
  n:=1;
  FOR i:=1 TO Num DO
  BEGIN
Loop:
    WITH Tab[i] DO
    BEGIN
      IF SendTo[n]<>'' THEN Add:=' ' ELSE Add:='';
      IF Zone<>Old.Zone THEN
        Add:=Add+AllNum(Zone)+':'+AllNum(Net)+'/'+AllNum(Node)
      ELSE
        IF Net<>Old.Net THEN
          Add:=Add+AllNum(Net)+'/'+AllNum(Node)
        ELSE
          IF Node<>Old.Node THEN Add:=Add+AllNum(Node);
      IF Point<>0 THEN Add:=Add+'.'+AllNum(Point);
      IF LENGTH(Add)+Length(SendTo[n])>50 THEN
      BEGIN
        INC(n);
        FillChar(Old, SizeOf(Old), 0);
        Old.Zone:=Cfg.Addresses[Cfg.MainAdrNum].Zone;
        GOTO Loop;
      END;
      Old.Zone:=Zone; Old.Net:=Net; Old.Node:=Node;
      SendTo[n]:=SendTo[n]+Add;
    END;
  END;
END;

PROCEDURE SortSendToTab(VAR Tab:SendToTabType; Num:BYTE);
VAR
  n,i:BYTE;
  Gem:TFidoAddress;
BEGIN
  IF Num>1 THEN
  BEGIN
    n:=1;
    WHILE n=1 DO
    BEGIN
      n:=0;
      FOR i:=1 TO Num-1 DO
        IF Address2Sort(Tab[i])>Address2Sort(Tab[i+1]) THEN
        BEGIN
          Gem:=Tab[i];
          Tab[i]:=Tab[i+1];
          Tab[i+1]:=Gem;
          n:=1;
        END;
    END;
  END;
END;

END.